R6 Class
R6 Object
library(Wu)
library(R6)
library(sloop)
library(epitools)
dt <- data.table(
outcome = sample(c(0,1), 100, replace = TRUE)
, treatment = factor(rep(c("case", "control"), 50), levels = c("case", "control"))
, sex = factor(sample(c("F", "M"), 100, replace = TRUE), levels = c("F", "M"))
)
RR <- R6Class(
"RR"
, list(binary = NA
, groups = NA
, data = NULL
, groups_nlevels = NULL
, tables = NULL
, freqs = NULL
, ors_str = NULL
, oddsratios = NULL
, riskratios = NULL
, fx_or = function(x) epitools::epitab(x, method = "oddsratio", oddsratio = "wald")
, fx_rr = function(x) epitools::epitab(x, method = "riskratio", oddsratio = "wald")
, initialize = function(binary, groups, data) {
self$binary <- binary
self$groups <- groups
vars <- c(binary, groups)
self$data <- data[, ..vars]
self$groups_nlevels <- lapply(groups, function(x) length(levels(self$data[[x]])))
self$tables <- lapply(self$groups, function(x) table(self$data[[x]], self$data[[self$binary]]))
self$freqs <- lapply(self$groups, function(x) Wu::tab_freq(self$binary, x, self$data))
self$ors_str <- Wu::get_ors(self$binary, self$groups, self$data)
self$oddsratios <- lapply(self$tables, self$fx_or)
self$riskratios <- lapply(self$tables, self$fx_rr)
}
))
RR1 <- RR$new(binary = "outcome", groups = c("treatment", "sex"), data = dt)
add_copy_icon <- function(id){
txt <- paste0('<button type=\"button\" onclick=\"selectElementContents( document.getElementById('
, '\''
, id
, '\''
, ') );\">Copy Table</button>')
cat(txt)
}
add_copy_icon("t1")| 0 | p0 | 1 | p1 | oddsratio | lower | upper | p.value | |
|---|---|---|---|---|---|---|---|---|
| F | 23 | 0.4791667 | 25 | 0.4807692 | 1.0000 | NA | NA | NA |
| M | 25 | 0.5208333 | 27 | 0.5192308 | 0.9936 | 0.4530886 | 2.178914 | 1 |
Test GPU (doesn’t work)
- http://www.r-tutor.com/gpu-computing/clustering/distance-matrix
- https://github.com/cdeterman/gpuR/wiki/Build-Instructions-for-Linux
test.data <- function(dim, num, seed = 17){
set.seed(seed)
matrix(rnorm(dim * dim), nrow = num)
}
m <- test.data(1200, 45000)
system.time(dist(m))
# Dev RViennaCL
devtools::install_github("cdeterman/RViennaCL")
# Dev gpuR
devtools::install_github("cdeterman/gpuR")
A <- seq.int(from=0, to=999)
B <- seq.int(from=1000, to=1)
gpuA <- gpuVector(A)
gpuB <- gpuVector(B)
C <- A + B
gpuC <- gpuA + gpuB
all(C == gpuC)Environment
R version 4.1.0 (2021-05-18) Platform: x86_64-pc-linux-gnu (64-bit) Running under: Ubuntu 20.04.2 LTS
Matrix products: default BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0 LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0
locale: [1] LC_CTYPE=C.UTF-8 LC_NUMERIC=C LC_TIME=C.UTF-8
[4] LC_COLLATE=C.UTF-8 LC_MONETARY=C.UTF-8 LC_MESSAGES=C.UTF-8
[7] LC_PAPER=C.UTF-8 LC_NAME=C LC_ADDRESS=C
[10] LC_TELEPHONE=C LC_MEASUREMENT=C.UTF-8 LC_IDENTIFICATION=C
attached base packages: [1] stats graphics grDevices utils datasets methods base
other attached packages: [1] epitools_0.5-10.1 sloop_1.0.1 R6_2.5.0
[4] Wu_0.0.0.9000 flexdashboard_0.5.2 lme4_1.1-27.1
[7] Matrix_1.3-4 mgcv_1.8-36 nlme_3.1-152
[10] png_0.1-7 scales_1.1.1 nnet_7.3-16
[13] labelled_2.8.0 kableExtra_1.3.4 plotly_4.9.4.1
[16] gridExtra_2.3 ggplot2_3.3.5 DT_0.18
[19] tableone_0.13.0 magrittr_2.0.1 lubridate_1.7.10
[22] dplyr_1.0.7 plyr_1.8.6 data.table_1.14.0
[25] rmdformats_1.0.2 knitr_1.33
loaded via a namespace (and not attached): [1] httr_1.4.2 sass_0.4.0 tidyr_1.1.3 jsonlite_1.7.2
[5] viridisLite_0.4.0 splines_4.1.0 bslib_0.2.5.1 assertthat_0.2.1 [9] highr_0.9 yaml_2.2.1 pillar_1.6.1 lattice_0.20-44
[13] glue_1.4.2 digest_0.6.27 rvest_1.0.0 minqa_1.2.4
[17] colorspace_2.0-2 htmltools_0.5.1.1 survey_4.0 pkgconfig_2.0.3
[21] haven_2.4.1 bookdown_0.22 purrr_0.3.4 webshot_0.5.2
[25] svglite_2.0.0 tibble_3.1.2 generics_0.1.0 ellipsis_0.3.2
[29] withr_2.4.2 klippy_0.0.0.9500 lazyeval_0.2.2 survival_3.2-11
[33] crayon_1.4.1 evaluate_0.14 fansi_0.5.0 MASS_7.3-54
[37] forcats_0.5.1 xml2_1.3.2 tools_4.1.0 hms_1.1.0
[41] mitools_2.4 lifecycle_1.0.0 stringr_1.4.0 munsell_0.5.0
[45] compiler_4.1.0 jquerylib_0.1.4 systemfonts_1.0.2 rlang_0.4.11
[49] grid_4.1.0 nloptr_1.2.2.2 rstudioapi_0.13 htmlwidgets_1.5.3 [53] crosstalk_1.1.1 rmarkdown_2.9 boot_1.3-28 gtable_0.3.0
[57] DBI_1.1.1 performance_0.7.2 utf8_1.2.1 insight_0.14.2
[61] stringi_1.6.2 Rcpp_1.0.7 vctrs_0.3.8 tidyselect_1.1.1 [65] xfun_0.24